perm filename CORC.SAI[SYS,HE] blob sn#166314 filedate 1975-02-07 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00009 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY CORNER
C00005 00003	⊃	CORNER FINDER -	XCRD and YCRD are upper left corner of window
C00008 00004	⊃	block to extract lines and calculate line equations
C00010 00005	
C00013 00006	⊃ Now group points into lines  if gap is small enough.
C00016 00007	⊃		    and calculate line equation if enough points found
C00019 00008	⊃   Find solutions, if any
C00022 00009	⊃	Store solutions found
C00031 ENDMK
C⊗;
ENTRY CORNER;
BEGIN "CRNR"

DEFINE	DEGTOL="12.0",		COMMENT TOLERENCE FOR LINE BUILDING;
	SLOTOL="0.6",		COMMENT MIN. SLOPE FOR INTERSECTING;
	OUTTOL="3.00",		COMMENT MAX. |LINES-INTERSECTION|;
	N="16",			COMMENT WINDOW SIZE-SAME AS IN MOVE;
	HN="(N DIV 2)",		COMMENT HALF WINDOW SIZE;
	MAR="(N DIV 5)",	COMMENT INTERSECTION EXTENSION;
	∂=" ",			COMMENT MAKE NULL FOR DEBUGGING;

	CRLF="'15&'12", ⊃ ="COMMENT", SAFEX=" ",
	SIARRAY="SAFEX INTEGER ARRAY", SRARRAY="SAFEX REAL ARRAY",
	WRITE(S) ="IF CDEBUG THEN BEGIN OUTSTR(S &CRLF);OUT(1,S&CRLF);
		END",
	RADIAN="180.0/3.14159",
	INT(X) = """    ""&""X=""&CVS(X)&",
	OINT(X) = """    ""&""X=""&CVOS(X)&",
	FINT(X) = """    ""&""X=""&CVF(X)&",
	LCR = "OUT(1,CRLF)";
	
⊃ permissible gaps in line segments - indexed into by DIR;

PRELOAD_WITH 3,2,1,2,3,2,1,2;
SIARRAY XGAPS[0:7];
PRELOAD_WITH 1,2,3,2,1,2,3,2;
SIARRAY YGAPS[0:7];

INTERNAL BOOLEAN CDEBUG;	⊃ TRUE if debugging turned on;
EXTERNAL SHORT INTEGER MAXI, NUM;

EXTERNAL PROCEDURE SHOW(INTEGER X,Y,L,WC1,WC2; STRING S);
EXTERNAL PROCEDURE SUPRES(REAL ARRAY XC,YC; REFERENCE INTEGER MAX);

⊃ for each direction (0:7) PTRS has frequency in row  3, row 1 contains
  pointers to beginning of linked  list in POINTS, row 2  has ends;

SHORT SIARRAY PTRS[0:7,1:3];
⊃	CORNER FINDER -	XCRD and YCRD are upper left corner of window;

INTERNAL BOOLEAN PROCEDURE CORNER(SHORT INTEGER CNT,XCRD,YCRD;
    SAFEX SHORT INTEGER ARRAY FEATR; SAFEX SHORT REAL ARRAY XC, YC);
	BEGIN "CORNER" SAFEX SHORT REAL ARRAY DEG[1:CNT];
	SHORT SIARRAY XCORD,YCORD,DX,DY,MAG,LFLAG,MPOINTS[1:CNT];
	SHORT INTEGER SIZE,J,I,PEAK_COUNT,CURR,LMAX,
		MAX_PEAK, MAX_LINS, DIR, SI, SJ, L, R, T, B;
	ARRCLR(PTRS,0);
∂ GETFORMAT(SI,SJ); ∂ SETFORMAT(7,2);
∂ IF CDEBUG THEN OUT(1,OINT(XCRD) OINT(YCRD) CRLF&CRLF);

⊃	save output from Sobel operator and build the list for each DIR;

	J ← 1;
∂ IF CDEBUG THEN OUT(1,"    X      Y      MAG     DX     DY ANGLE"&CRLF);
	FOR I ← 1 STEP 1 UNTIL CNT DO
		BEGIN "UNPACK"
		MAG[I] ← FEATR[J];
		XCORD[I]←FEATR[J+4];
		YCORD[I]←FEATR[J+5];
		DX[I] ← FEATR[J+1];
		DY[I] ← FEATR[J+2];
		R ← ATAN2(DX[I],DY[I])*RADIAN;
		DEG[I] ← IF R≥0 THEN R ELSE 360.0+R;
		DIR ← FEATR[J+3];
∂ IF CDEBUG THEN OUT(1,CVOS(XCORD[I])&CVOS(YCORD[I])&CVS(MAG[I])&
∂ CVS(DX[I])&CVS(DY[I])&CVF(DEG[I])&CVS(DIR)&CVS(I)&CRLF);
		PTRS[DIR,3]←PTRS[DIR,3]+1;
		IF ¬PTRS[DIR,1] THEN PTRS[DIR,1]←I
			ELSE MPOINTS[PTRS[DIR,2]]←I;
		PTRS[DIR,2]←I;
		J ← J+6;
		END "UNPACK";

⊃	now look for peaks. Test for peaks higher than criteria;

∂ WRITE("""Number of Points in this window=""&CVS(CNT)");
	MAX_PEAK ← PEAK_COUNT←0;
	FOR I←0 STEP 1 UNTIL 7 DO
		BEGIN "PK"
		CURR←PTRS[I,3];
		IF CURR>3 THEN
			BEGIN "P2"
			PEAK_COUNT←PEAK_COUNT+1;
			MAX_PEAK←MAX_PEAK MAX CURR;
			END "P2";
		END "PK";
∂ WRITE("""Number of peaks = ""&CVS(PEAK_COUNT)");
	SIZE ← MAX_PEAK*3;
	MAX_LINS ← 8*8*PEAK_COUNT;
	IF ¬SIZE THEN RETURN(FALSE);
⊃	block to extract lines and calculate line equations;

	BEGIN "LINES"
	SHORT INTEGER K,STRLIN,THISP,LINENO,IPT;
	SHORT REAL SX, SY, SDX, SDY, AVE, SN, XL, XR, YTT, YB, SM, DG;
	SHORT SIARRAY INDEX,LINES[1:SIZE];
	SHORT SRARRAY COEF[1:MAX_LINS];
	LABEL TEXT;

⊃	extract line segments of direction INDX from data structure;

	SIMPLE PROCEDURE EXTRACT(SHORT INTEGER INDX);
		BEGIN "EXT"
		SHORT INTEGER FOO1;
		FOO1←PTRS[INDX,1];	⊃ pick up the start of the list;
		DO	BEGIN "IEXT"
			IF XCORD[FOO1] THEN
				BEGIN
				J←J+1;
				LINES[J]←FOO1;
				END;
			FOO1←MPOINTS[FOO1];
			END "IEXT" UNTIL ¬FOO1;
		END "EXT";

⊃	get line coefficients and limits  from COEF;

	SIMPLE PROCEDURE COEFF_GET(INTEGER KNT; REFERENCE REAL A,B,C;
	    REFERENCE INTEGER L, R, T, BB, AREA);
		BEGIN "CG"
		A←COEF[KNT];
		B←COEF[KNT+1];
		C←COEF[KNT+2];
		L←COEF[KNT+3];
		R←COEF[KNT+4];
		T←COEF[KNT+5];
		BB←COEF[KNT+6];
		AREA←COEF[KNT+7];
		END "CG";

⊃	accumulate partial sums, set limits, and return current average;

	SIMPLE REAL PROCEDURE ACCUM(INTEGER X, Y, I, J);
		BEGIN REAL MAGX;
		MAGX ← MAG[I];
		SX ← SX+MAGX*X;
		SY ← SY+MAGX*Y;
		SDX ← SDX+MAGX*DX[I];
		SDY ← SDY-MAGX*DY[I];
		SN ← SN+1.0;
		SM ← SM+MAGX;
		AVE ← AVE+MAGX*DEG[I];
		IPT ← IPT+1;
		INDEX[IPT] ← J;
		IF L>X THEN L ← X;
		IF R<X THEN R ← X;
		IF T>Y THEN T ← Y;
		IF B<Y THEN B ← Y;
		RETURN(AVE/SM);
		END;

	SIMPLE BOOLEAN PROCEDURE INSIDE(REAL LEFT, VAL, RIGHT);
		RETURN(LEFT-OUTTOL≤VAL≤RIGHT+OUTTOL);

⊃	first fill LINES with indices for each triplet of directions;

	STRLIN ← 1;
	FOR DIR←0 STEP 1 UNTIL 7 DO IF PTRS[DIR,3] THEN
		BEGIN "EXTR"
		SHORT REAL DE, TOLER;
		SHORT INTEGER Q,FIRST,NEXT,X,Y,XX,YY,GAPX,GAPY,PTR,P;
		P ← (DIR+7) MOD 8;
		Q ← (DIR+1) MOD 8;
		J ← 0;
		EXTRACT(DIR);
		THISP ← J;
		IF ¬J THEN CONTINUE;
		IF PTRS[P,3] THEN EXTRACT(P);
		IF PTRS[Q,3] THEN EXTRACT(Q);
		IF THISP<3 THEN CONTINUE;
⊃ Now group points into lines  if gap is small enough.
  We  allow GAP to be 3 in the  DIR direction, and only 1
  orthogonal to DIR. Also, difference in direction must be under DEGTOL.
  Lines must have at least four points;

		GAPX ← XGAPS[DIR];
		GAPY ← YGAPS[DIR];
		PTR ← 1;
		DO  BEGIN "L2" INTEGER PNTR, IND;
		    ARRCLR(LFLAG,0);
		    K ← FIRST ← LINES[PTR];
		    LFLAG[K] ← TRUE;
		    IPT ← 0;
		    PNTR ← 1;
		    X ← XCORD[FIRST];
		    Y ← YCORD[FIRST];
		    DE ← DEG[FIRST];
		    T ← L ← 500;
		    B ← R ← SX ← SY ← SDX ← SDY ← AVE ← SN ← SM ← 0;
∂		    IF CDEBUG THEN OUT(1,CRLF&CVS(FIRST));
		    WHILE TRUE DO
			BEGIN "L3"
			FOR IND←1 STEP 1 UNTIL J DO IF IND≠K THEN
			    BEGIN "L4"
			    IF SN<2.5 THEN TOLER←DEGTOL*(1.+(2.-SN)*.4);
			    NEXT ← LINES[IND];
			    IF ¬NEXT∨LFLAG[NEXT] THEN CONTINUE;
			    XX ← XCORD[NEXT];
			    YY ← YCORD[NEXT];
			    DG ← ABS(DE-DEG[NEXT]);
			    IF ABS(Y-YY)>GAPY∨ABS(X-XX)>GAPX∨
				DG MIN (360.0-DG)>TOLER THEN CONTINUE;
			    LFLAG[NEXT] ← TRUE;
			    IF FIRST THEN
				BEGIN
				ACCUM(X,Y,FIRST,PTR);
				FIRST ← 0;
				END ;
			    DE ← ACCUM(XX,YY,NEXT,IND);
∂			    IF CDEBUG THEN
∂				BEGIN
∂				OUT(1,CVS(NEXT));
∂				IF ¬(SN MOD 10) THEN LCR;
∂				END;
			    END "L4";
			PNTR ← PNTR+1;
			IF PNTR>IPT THEN DONE;
			K ← LINES[INDEX[PNTR]];
			X ← XCORD[K];
			Y ← YCORD[K];
			END "L3";
⊃		    and calculate line equation if enough points found;

		    IF SN>2.5 THEN
			BEGIN "COEF" SHORT REAL AX, AY, ADX, ADY;
			INTEGER J;
			FOR I←1 STEP 1 UNTIL IPT DO
		 	    BEGIN
			    J ← INDEX[I];
			    LINES[J] ← XCORD[LINES[J]] ← 0;
			    END;
			AX ← SX/SM;
			AY ← SY/SM;
			ADX ← SDX/SM;
			ADY ← SDY/SM;
∂ I ← AX; ∂ J ← AY; ∂ IF CDEBUG THEN OUT(1,CRLF& FINT(AX) FINT(AY) OINT(I)
∂ OINT(J) FINT(ADX) FINT(ADY) CRLF);
			IF ABS(ADX)<ABS(ADY) THEN
			    BEGIN "A3"
			    COEF[STRLIN]←-ADX/ADY;
			    COEF[STRLIN+1]← -1.0;
			    COEF[STRLIN+2]←AY+ADX*AX/ADY;
			    END "A3" ELSE BEGIN "A4"
			    COEF[STRLIN]←1.0;
			    COEF[STRLIN+1]←ADY/ADX;
			    COEF[STRLIN+2]←-ADY*AY/ADX-AX;
			    END "A4";
			COEF[STRLIN+3]←L;
			COEF[STRLIN+4]←R;
			COEF[STRLIN+5]←T;
			COEF[STRLIN+6]←B;
			COEF[STRLIN+7]←(B-T+1)*(R-L+1);
			STRLIN ← STRLIN+8;
			END "COEF";
		    DO PTR←PTR+1 UNTIL PTR+3>THISP∨LINES[PTR]>0;
		    END "L2" UNTIL PTR+3>THISP;
		END "EXTR";

⊃	now COEF is filled with blocks of lines, so we look for solutions;

	LINENO ← STRLIN DIV 8;
∂ WRITE("CRLF&""NUMBER OF LINES= ""&CVS(LINENO)");
	IF LINENO≥N/2 THEN
TEXT:		BEGIN
∂ WRITE("""TEXTURE"""); ∂ SETFORMA](SI,SJ);
		RETURN(FALSE);
		END;
	XL ← XCRD-MAR;
	XR ← XCRD+MAR+N-1;
	YTT ← YCRD-MAR;
	YB ← YCRD+MAR+N-1;
⊃   Find solutions, if any;

    IF LINENO≥2 THEN BEGIN "FEAT" SAFEX SHORT REAL ARRAY XT, YT[1:LINENO↑2];
	LMAX ← 0;
	FOR I←1 STEP 8 UNTIL STRLIN-9 DO
		BEGIN "SOLVE"
		SHORT REAL A,BR,C,M,NN,P,X,Y;
		SHORT INTEGER KK,TT,BB,LL,RR,AR1,AR2,AR3,H;
		COEFF_GET(I,A,BR,C,L,R,T,B,AR1);
		FOR KK ← I+8 STEP 8 UNTIL STRLIN-1 DO
			BEGIN "S4" REAL SLOPE;
			COEFF_GET(KK,M,NN,P,LL,RR,TT,BB,AR2);
			SLOPE ← ABS(A*NN-M*BR);
∂			IF CDEBUG THEN OUT(1,INT(I) INT(KK) FINT(SLOPE)CRLF);
			IF SLOPE<SLOTOL THEN CONTINUE;
			H ← (B MIN BB)-(T MAX TT);
			AR3 ← H*((R MIN RR)-(L MAX LL))*3 DIV 2;
∂			IF CDEBUG THEN OUT(1,INT(AR1) INT(AR2) INT(AR3)
∂				INT(H) CRLF);
			IF H>0∧AR3>0∧(AR3>AR1∨AR3>AR2) THEN CONTINUE;
			IF ABS(BR)>ABS(C) THEN
			    BEGIN
			    X←(NN*C-BR*P)/(BR*M-NN*A);
			    Y←(-C-A*X)/BR;
			    END ELSE BEGIN
			    Y←(M*C-A*P)/(NN*A-M*BR);
			    X←(-C-BR*Y)/A;
			    END;
∂			IF CDEBUG THEN OUT(1,FINT(X) FINT(Y) CRLF);
			IF ¬(XL<X≤XR∧YTT<Y≤YB) THEN
			    BEGIN ∂ WRITE("""OUTSIDE WINDOW"""); END ELSE
			IF ¬INSIDE(L,X,R)∨¬INSIDE(LL,X,RR)∨
			   ¬INSIDE(TT,Y,BB)∨¬INSIDE(T,Y,B) THEN
			    BEGIN ∂ WRITE("""LINES DO NOT INTERSECT"""); END
			    ELSE BEGIN "PRESTO"
				LMAX ← LMAX+1;
				XT[LMAX] ← X;
				YT[LMAX] ← Y;
∂				IF CDEBUG THEN OUT(1,CRLF&INT(LMAX) CRLF);
∂				WRITE("""SOLUTION FOUND""");
				END "PRESTO";
			END "S4";
		END "SOLVE";
∂	SETFORMAT(SI,SJ);
⊃	Store solutions found;

	IF LMAX THEN
		BEGIN "OUTP"
		SUPRES(XT,YT,LMAX);
∂		WRITE("""FOUND  ""&CVS(LMAX)&"" SOLUTIONS""");
		IF LMAX>2 THEN GO TO TEXT;
		FOR I←1 STEP 1 UNTIL LMAX DO
			BEGIN "STORE" SHORT INTEGER X,Y;
			IF MAXI+1<NUM↑2 THEN MAXI←MAXI+1 ELSE
			    BEGIN
			    OUTSTR("TOO MANY FEATURES"&CRLF);
			    DONE;
			    END;
			X← (XC[MAXI]←XT[I]-HN)+.5;
			Y← (YC[MAXI]←YT[I]-HN)+.5;
			IF CDEBUG THEN
			    BEGIN
			    SHOW(X,Y,2,X+HN,Y+HN,"FEATURE");
			    CDEBUG←INCHRW≠"Q";
			    END;
			END "STORE";
		RETURN(TRUE);
		END "OUTP";
	END "FEAT";
	END "LINES";
∂	WRITE("""NO GOOD INTERSECTIONS""");
	RETURN(FALSE);
	END "CORNER";
END "CRNR";